home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Forever 4
/
Atari Forever 4.zip
/
Atari Forever 4.iso
/
PD_THEMA
/
ASTRONOM
/
ASTRO_3
/
EPROG_01.BAS
< prev
next >
Wrap
BASIC Source File
|
1998-03-14
|
12KB
|
328 lines
1 '******* E P R O G Version 0.1 *******
2 '********Ephemeridenprogramm*************
4 fullw 2:clearw 2:gotoxy 0,0
5 gosub 69 : goto 190
10 rem Keplergleichung
11 rem
12 let p1= 3.14159265: let r1= 180/p1
13 let k= 0.01720209895
18 if e0 >= 0.95 then goto 40
19 if e0 >= 1 then goto 85
20 let a1= q/(1-e0):let m=k * t * a1^(-1.5)
21 rem
22 rem
23 rem
24 let f= sgn (m): let m= abs(m)/(2* p1)
25 let m= (m-int(m))*2*p1*f
26 if m < 0 then m=m + 2 * p1
27 let f=1 : if m > p1 then f= -1
28 if m > p1 then m= 2*p1 - m
29 let e= p1 / 2 : let d= p1 / 4
30 for i1= 1 to 23
31 let m1= e - e0 * sin(e)
32 let e= e + sgn(m-m1)*d:let d=d/2
33 next i1
34 let v= sqr((1+e0)/(1-e0)): let e= e*f
35 let v= 2*atn (v*sin(e/2)/cos(e/2))
36 let r=a1 * (1-e0*cos(e))
38 goto 81
39 rem
40 rem Gaussmethode
41 rem
43 let a= sqr((1+9*e0)/10)
44 let b= 5 * (1-e0)/(1+9*e0)
45 let c= sqr(5*(1+e0)/(1+9*e0))
46 let b1= 3*a*k*t / sqr(2*q*q*q)
47 let b2= 1
48 let w1= b2*b1: let b3= atn(2/w1)
49 let t1= sin(b3 / 2)/cos(b3/2)
50 let s1= sgn(t1): let t1= abs(t1)
51 let t2= t1^(1/3)* s1: let g= atn(t2)
52 let s= 2*cos(2*g)/sin(2*g)
53 let a2= b*s*s : let b0= b2: let b2= 0
54 if abs(a2) > 0.3 then 19
55 for j= 0 to 7
56 let b2= b2+ b(j) * a2 ^j
57 next j
58 if abs(b2 - b0) > 1*10^-8 then 48
59 let c1= 0
60 for j= 0 to 7
61 let c1= c1 + s(j)*a2^j
62 next j
63 let c1= sqr (1/c1)
64 let v1= c * c1 * s: let d1= 1/(1+a2*c1*c1)
65 let v= 2* atn (v1): let r= q* d1*(1+v1*v1)
67 goto 81
68 rem
69 rem Koeffizienten
70 for j= 0 to 7: read b(j): next
71 for j= 0 to 7: read s(j): next
72 return
73 data 1,0,-0.017142857
74 data -0.003809524,-0.001104267
75 data -0.000367358,-0.000131675
76 data -0.000049577,1,-0.8
77 data 0.04571429,0.0152381
78 data 0.00562820,0.00218783
79 data 0.00087905,0.00036155
80 return
81 if v < 0 then v= v +2*p1
84 goto 86
85 print"Hyperbel!"
86 return
190 input"Bahnelemente eingeben(1) oder vorgegebene benutzen(2) ";ba
192 if ba=1 then goto 206
194 if ba=2 then goto 2000
200 rem kometenposition
206 print"Periheldatum"
207 gosub 800 : let j9= j: let f9= f
208 input"Periheldistanz(q)";q
209 input"Exzentrizität ";e0
212 input"Klein-Omega ";w
215 input"Gross-Omega ";n
218 input"Bahnneigung ";i
220 print:input"m(1,1)";mag
222 input"n ";nf
233 let p1= 3.14159265:let r1= p1/180
236 e= 23.4457889 * r1
239 let w= w * r1 :let n=n * r1 :let i= i * r1
242 gosub 338
245 print
246 print"Beobachtungsdatum"
247 gosub 800: let j1= j: let f1= f
248 gosub 500: let t= (j1 - j9) + (f1 - f9)
249 gosub 10
254 let x1= r * cos (v): let y1 = r * sin(v)
260 rem heliozentrisch
263 let x2= p7 * x1 + q7 * y1
266 let y2= p8 * x1 + q8 * y1
269 let z2= p9 * x1 + q9 * y1
272 rem geozentrisch
278 let x3= x + x2 : let y3= y + y2: let z3= z + z2
284 let d3= sqr (x3 * x3 + y3 * y3 + z3 * z3)
287 let r1= p1 / 180
290 let a= atn (y3 / x3)/(15 * r1)
293 if x3 < 0 then let a=a+12
296 if a< 0 then let a=a+24
299 let d=atn (z3 / sqr (x3*x3 + y3*y3)) / r1
301 rem aufrunden
302 let a=a+0.05/60
305 let h=int(a):let m= 60 * (a-h)
308 let m=int(10*m)/10
311 let s=sgn (d):let d= abs (d)+0.5/60
314 let d1= int (d) : let m1 = int(60*(d-d1))
317 let s$="+":if s= -1 then let s$ = "-"
318 mag2=mag+5*log10(d3)+2.5*nf*log10(r):mag2=mag2*10
319 mag3=cint(mag2):mag3=mag3/10
320 print tab(2) chr$(224);tab(17) chr$(235);tab(29) chr$(127);tab(45) "r"; tab(58);"mag"
322 print"------------------------------------------------------------------"
325 print tab(1) h;"h ";m;"m";tab(18) s$;d1;chr$(248);m1;"'";tab(29) d3;"AE"; tab(45) r;"AE";tab(58);mag3
330 goto 245
332 end
335 rem p + q
338 rem
344 let w1= sin(w): let w2= cos (w)
347 let n1= sin (n): let n2= cos (n)
350 let i1= sin (i): let i2= cos (i)
353 let e1= sin (e): let e2= cos (e)
356 let p7= w2 * n2 - w1 * n1 * i2
359 let p8= (w2 * n1 + w1* n2*i2)*e2
362 let p8= p8 - w1 * i1 * e1
365 let p9= (w2 * n1 + w1*n2*i2)*e1
368 let p9= p9 + w1 * i1 * e2
371 let q7= -w1 * n2 -w2 * n1* i2
374 let q8= (-w1 * n1 + w2 *n2 * i2) * e2
377 let q8=q8 - w2 *i1 *e1
380 let q9=(-w1 * n1 +w2 * n2 * i2)* e1
383 let q9=q9 + w2 *i1 * e2
386 return
410 let x4=a7 * x3 +a8 *y3 + a9 * z3
413 let y4= b7 * x3 + b8 * y3 + b9 * z3
416 let z4= c7 * x3 + c8 * y3 + c9 * z3
419 let x3= x4 : let y3= y4: let z3= z4
422 return
500 rem sonnenkoordinaten
501 rem
502 rem
504 let j8= j-2415020: let r1=3.14159265/180
505 let t= (j8+f)/36525
506 let p0=1.396041+0.000308*(t+0.5)
507 let p0=p0 * (t-0.499998)
508 let a=100: gosub 529: let g0= a+ 358.475833
509 let l0=a +279.696678-p0
510 let a=1336 : gosub 529
511 let c0= a+ 270.434164 - p0
512 let a= 162 : gosub 529
513 let v0=a + 212.603219
514 let a= 53 : gosub 529 : let m0= a + 319.529425
515 let a= 8 : gosub 529: let j0=a + 225.444651
516 let g= g0 + t * (-0.950250 - 0.000150 * t)
517 let c= c0 + t * (307.883142 - 0.001133 * t)
518 let l= l0 + t * (0.768920 + 0.000303 * t)
519 let v= v0 + t * (197.803875 + 0.001286 * t)
520 let m= m0 + t * (59.8585 + 0.000181 * t)
521 let j= j0 + t * 154.906654
522 let g= g * r1 : let c= c* r1: let l= l* r1
523 let v= v * r1: let m= m * r1: let j= j * r1
524 gosub 532
528 return
529 rem normalisierung
530 let a= 360 * (a*t-int(a*t)):return
531 rem
532 let x= 0.000011 * cos (2*g-l-2*j)
533 let x= x + 0.000011 * cos (2*g+l-2*v)
534 let x= x - 0.000012 * cos (g+l-v)
535 let x= x - 0.000012 * cos (4*g-l-8*m+3*j)
536 let x= x + 0.000012 * cos (4*g+l-8*m+3*j)
537 let x= x - 0.000014 * cos (c-2*l)
538 let x= x + 0.000017 * cos (c)
539 let x= x + 0.000018 * sin (2*g+l-2*v)
540 let x= x - 0.000021 * t * cos ( g+l )
541 let x= x - 0.000026 * sin (g-l-j)
542 let x= x + 0.000035 * cos ( 2*g-l)
543 let x= x + 0.000063 * t * cos (g-l)
544 let x= x + 0.000105 * cos (2*g+l)
545 let x= x + 0.008374 * cos (g+l)
546 let x= x - 0.025127 * cos (g-l)
547 let x= x + 0.999860 * cos (l)
548 rem
549 let y= 0.00010 * sin (2*g+l-2*v)
550 let y= y - 0.000010 * sin (2*g-l-2*j)
551 let y= y - 0.000011 * sin (g+l-v)
552 let y= y + 0.000011 * sin (4*g-l-8*m+3*j)
553 let y= y + 0.000011 * sin (4*g+l-8*m+3*j)
554 let y= y + 0.000013 * sin (c-2*l)
555 let y= y + 0.000016 * sin (c)
556 let y= y - 0.000017 * cos (2*g+l-2*v)
557 let y= y - 0.000019 * t * sin(g+l)
558 let y= y - 0.000024 * cos (g-l-j)
559 let y= y - 0.000032 * sin (2*g-l)
560 let y= y - 0.000057 * t * sin (g-l)
561 let y= y + 0.000097 * sin (2*g+l)
562 let y= y + 0.007683 * sin (g+l)
563 let y= y + 0.023053 * sin (g-l)
564 let y= y + 0.917308 * sin (l)
565 rem
566 let z= -0.000010 * cos (g-l-j)
567 let z= z - 0.000014 * sin (2*g-l)
568 let z= z - 0.000025 * t * sin (g-l)
569 let z= z + 0.000042 * sin (2*g+l)
570 let z= z + 0.003332 * sin (g+l)
571 let z= z + 0.009998 * sin (g-l)
572 let z= z + 0.397825 * sin (l)
573 return
800 rem jd.
805 rem
810 input"Jahr,Monat,Tag";y,m,d
815 let g= 1
820 let d1= int(d): let f= d-d1-0.5
825 let j= -int(7*(int((m+9)/12)+y)/4)
830 if g= 0 then 850
835 let s= sgn (m-9): let a= abs(m-9)
840 let j1= int (y+s*int(a/7))
845 let j1= -int((int(j1/100)+1)*3/4)
850 let j= j + int (275*m/9)+d1+g*j1
855 let j= j + 1721027 + 2 * g + 367 * y
860 if f >= 0 then 870
865 let f= f + 1 : let j=j - 1
870 return
875 end
1100 j=2446219:f=0.5684:q=0.526131:e0=0.468462:w=54.8416:n=152.0502:i=9.9219
1120 if knr=2 then goto 4030
2000 rem Bahnelemente verschiedener Kometen
2010 print spc(15) "Inhaltverzeichnis:":print
2020 print spc(10) "P/Halley (#1) 1986n Sorrells (#13)"
2030 print spc(10) "P/Machholz (#2)"
2040 print spc(10) "P/Denning-Fujikawa (#3)"
2050 print spc(10) "P/Brorsen-Metcalf (#4)"
2060 print spc(10) "P/Giacobini-Zinner (#5)"
2070 print spc(10) "P/Ciffréo (#6)"
2080 print spc(10) "P/Shoemaker 3 (#7)"
2090 print spc(10) "P/Grigg-Skjellerup (#8)"
2100 print spc(10) "P/Encke (#9)"
2110 print spc(10) "P/Temple-Tuttle (#10)"
2115 print spc(10) "P/Takamizawa (#11)"
2120 print spc(10) "1986l Wilson (#12)"
2510 print spc(10) "1984 QA (Planetoid)(#20)"
2520 print spc(10) "1986 DA (Planetoid)(#21)"
3000 print:input "Welcher Komet (Kennzahl eingeben)";knr
3010 if knr=1 then goto 4020
3020 if knr=2 then goto 4030
3030 if knr=3 then goto 4040
3040 if knr=4 then goto 4050
3045 if knr=5 then goto 4055
3050 if knr=6 then goto 4060
3055 if knr=7 then goto 4065
3060 if knr=8 then goto 4070
3065 if knr=9 then goto 4075
3070 if knr=10 then goto 4080
3075 if knr=11 then goto 4085
3080 if knr=12 then goto 4090
3085 if knr=13 then goto 4095
3500 if knr=20 then goto 4500
3510 if knr=21 then goto 4510
4000 '*******BAHNELEMENTE*******
4019 '***P/HALLEY***
4020 j=2446470:f=0.95862:q=0.5871013:e0=0.9672750:w=111.84652:n=58.14341
4021 i=162.23921:j9=j:f9=f:mag=3.1:nf=3.092
4022 rem Quelle:D.K.Yeomans(JPL),IAUC#4156
4024 goto 233
4029 '***P/MACHOLZ***
4030 j=2446544:f=0.034:q=0.12684:e0=0.95847:w=14.595:n=93.741:i=60.209
4032 j9=j:f9=f:rem Quelle:S.Nakano(Tokio),IAUC#4223
4034 goto 233
4039 '***P/DENNING-FUJIKAWA***
4040 j=2447012:f=0.600:q=0.76250:e0=0.82180:w=338.260:n=35.860:i=9.430
4042 j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening),VORLÄUFIG
4044 goto 233
4049 '***P/BRORSEN-METCALF***
4050 j=2447798:f=0.4:q=0.4781:e0=0.9720:w=129.73:n=310.84:i=19.33
4051 mag=9:nf=4
4052 j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening),University of Arizona Press; nur vorläufige Bahnelemente!
4053 goto 233
4054 '***P/GIACOBINI-ZINNER***
4055 j=2446313:f=0.7058:q=1.028255:e0=0.707518:w=172.4856:n=194.7060
4057 i=31.8784:j9=j:f9=f:mag=11:nf=4:rem Quelle:D.K.Yeomans(JPL),IAUC#4
4058 goto 233
4059 '***P/CIFFREO***
4060 j=2446368:f=0.1291:q=1.701961:e0=0.545690:w=357.6362:n=53.1030:i=13.1074
4062 j9=j:f9=f:rem Quelle:D.W.E Green(SAO),IAUC#4145
4063 goto 233
4064 '***P/SHOEMAKER 3***
4065 j=2446418:f=0.1056:q=1.794136:e0=0.727579:w=14.8422:n=96.6297:i=6.4076
4067 j9=j:f9=f:rem Quelle:S.Nakano(Tokio),IAUC#4180
4068 goto 233
4069 '***P/GRIGG-SKJELLERUP***
4070 j=2446966:f=0.6:q=0.9933:e0=0.6648:w=359.31:n=212.63:i=21.11:mag=12.5:nf=4
4072 j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening); nur vor- läufige Bahnelemente!
4073 goto 233
4074 '***P/ENCKE***
4075 j=2446993:f=0.9:q=0.3317:e0=0.8499:w=186.26:n=334.03:i=11.93:mag=12:nf=4
4077 j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening);Bahnele- mente und Helligkeitsparameter nur angenähert!
4078 goto 233
4079 '***P/TEMPLE-TUTTLE***
4080 j=2450871:f=0.9:q=0.9758:e0=0.9056:w=172.52:n=234.56:i=162.48:mag=8:nf=4
4081 j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),in "Comets"(ed.L.Wilkening);nur vorläufige Bahnelemente!
4082 goto 233
4084 '***P/TAKAMIZAWA***
4085 j=2445845:f=0.4464:q=1.596101:e0=0.574508:w=147.5732:n=124.2395:i=8.4920
4086 rem Wenn man den richtigen i-Wert einsetzt, dann"function not yet done!"
4087 i=i+1:j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),IAUC#3974
4088 goto 233
4089 '***1986L WILSON***
4090 j=2446906:f=0.27867:q=1.1987709:w=238.33253:n=110.95353:e0=1.0:i=147.12800
4091 mag=3.2:nf=4.6:j9=j:f9=f:rem Quelle:Minor Planet Circular #11236
4092 goto 233
4094 '***1986N SORRELLS***
4095 j=2446864:f=0.378:q=1.7105:e0=1.0:w=70.677:n=74.064:i=160.600
4096 mag=7:nf=4:j9=j:f9=f:rem Quelle:Privatmitteilung P.Schmeer
4097 goto 233
4499 '***1984 QA***
4500 j=2446219:f=0.5684:q=0.526131:e0=0.468462:w=54.8416:n=152.0502:i=9.9219
4502 j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),IAUC#4095
4504 goto 233
4509 '***1986 DA***
4510 j=2446526:f=0.7487:q=1.168213:e0=0.539019:w=123.2482:n=66.4558:i=4.1631
4512 j9=j:f9=f:rem Quelle:T.Urata(Tokio),IAUC#4181
4514 goto 233
ə